perm filename EMACLS.15[MAC,LSP]1 blob
sn#594246 filedate 1981-06-10 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00026 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 MacLisp portion of the E/MacLisp Interface.
C00021 00003 E Manipulation Routines
C00027 00004 Routines to queue up mail
C00029 00005 αxSLISP dsk:maclsp.dmp[1,3](elisp.ini)
C00038 00006 Mail Interface
C00042 00007 Mail Type
C00047 00008 Wait Mail
C00050 00009 Mask Routines
C00052 00010 Mail SFA
C00056 00011 Tyi
C00059 00012 Tyo
C00061 00013 Force Output
C00065 00014 Message Align
C00067 00015 Mail Refresh
C00072 00016 Transfer Buffer
C00074 00017 Wait OK
C00075 00018 Send Simple Message
C00078 00019 Send Control Char
C00080 00020 Em:init
C00082 00021 Send OK
C00083 00022 Em:eval-protect
C00084 00023 Mail queue
C00086 00024 Readonly Variables
C00092 00025 Debugging Routines
C00093 00026 Storage for Mail routines
C00096 ENDMK
C⊗;
;;; MacLisp portion of the E/MacLisp Interface.
;;;
;;; An SFA/MAIL based system for communicating with
;;; an unstructured, standard text editor.
;;; Starts with si:ejobnum figured out from E.
;;; (sfa-call <sfa> 'send-lines n)
;;; sets the number of lines that are sent at one time to n.
;;; normal is T (meaning send every line).
;;; NIL means never send.
;;; (sfa-call <sfa> 'report-send-lines) returns the value
;;; si:ecalledp, the global variable, tells whether E called you
(declare (mapex t)
; (setq defmacro-for-compiling ())
(special -em:ecommands- -em:sfa- -em:errorp-
-em:oldtyi- -em:oldtyo- -em:mode- -em:silence-
-em:mail-input-buffer-dry-handler- -em:queue-
-em:herald- -em:cmchar-table- -em:si:ecalledp- si:ejobnum
si:sail-mail-service
-em:filemode- -em:linel-)
(*expr em:get-next-readonly em:force-readonly-message em:make-sixbit
em:readonly-init em:warn em:message-align em:send-simple-message
em:mail-sfa em:init-send-lines em:init em:get-jobnum
em:turn-mask-off em:business-address em:mail-interrupt-handler
em:mask-on em:eval-protect em:mask-off)
(*lexpr em:fread %match)
(fixnum si:ejobnum))
(setq -em:ecommands- ()
-em:mail-input-buffer-dry-handler- ()
-em:mode- 'LTYPE
-em:si:ecalledp- ()
-em:oldtyi- tyi -em:oldtyo- tyo
-em:filemode- ()
-em:cmchar-table- ()
-em:herald- '|MacLisp Ready|
-em:silence- ()
-em:linel- (linel t))
(defun em:mail-interface-initialize ()
(em:turn-mask-off)
(setq -em:queue- ())
(em:initialize)
(setq -em:si:ecalledp- t)
(and -em:herald-
(progn (princ -em:herald-)(terpri)))
(sfa-call -em:sfa- 'force-output ())
(setq si:sail-mail-service 'em:mail-interrupt-handler)
)
(setq -em:sfa- ())
(sstatus ttyint 232. '+internal-↑B-break)
(sstatus ttyint 200. '+internal-↑B-break)
(defun em:initialize ()
(em:get-jobnum)
(em:init)
(em:init-send-lines)
(setq -em:sfa- (sfa-create (function em:mail-sfa) 0 'mail-sfa))
(setq tyi -em:sfa-)
(setq tyo -em:sfa-)
(setq msgfiles `(,-em:sfa-))
(sfa-store -em:sfa- 'xcons -em:sfa-)
(em:send-simple-message 'ok)
)
(defmacro unascii (x)
`(car (exploden ,x)))
(defun em:ecommands (l)
(sfa-call -em:sfa- 'force-output ())
(let ((-em:ecommands- t))
(do ((com l (cdr com)))
((null com)(sfa-call -em:sfa- 'force-output ()))
(cond ((eq (car com) '<cr>)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o27))
((eq (car com) '<lf>)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o1))
((eq (car com) '<sp>)
(sfa-call -em:sfa- 'tyo '32.))
((eq (car com) '<bs>)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o102))
((eq (car com) '<tab>)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o75))
((eq (car com) '<⊗>)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o26))
((eq (car com) '<alt>)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o33))
(t
(sfa-call -em:sfa- 'tyo
(unascii (car com))))))))
;;; Like above, but takes ascii codes
(defun em:raw-ecommands (l)
(sfa-call -em:sfa- 'force-output ())
(let ((-em:ecommands- t))
(do ((com l (cdr com)))
((null com)(sfa-call -em:sfa- 'force-output ()))
(cond ((= (car com) #o11)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o75))
((= (car com) #o175)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o33))
(t
(sfa-call -em:sfa- 'tyo
(cond ((= (car com) #o15) #o26)
((= (car com) #o12) #o27)
(t (car com)))))))))
(defun em:set-send-lines (n)
(sfa-call -em:sfa- 'send-lines n))
(defun em:get-send-lines ()
(sfa-call -em:sfa- 'report-send-lines ()))
(defun em:force ()
(sfa-call -em:sfa- 'force-output ()))
;(setq read-eval-print-* 'em:terpri)
(defun em:terpri () (terpri -em:sfa-))
(defun em:real-terpri () (tyo #o40 -em:sfa-)(terpri -em:sfa-))
(defun em:eval-message ()
((lambda (eof)
(em:message-align)(em:set-send-lines t)
(do ((form (em:fread eof) (em:fread eof))
(l nil))
((eq form eof)
(do ((i (nreverse l) (cdr i)))
((null i)
(sfa-call -em:sfa- 'force-output ())
(em:set-send-lines ()))
(print (car i))))
(setq l (cons (eval form) l)))) (ncons ())))
(defun em:eval-message-warn ()
((lambda (eof)
(em:message-align)(em:set-send-lines t)
(do ((form (em:fread eof) (em:fread eof))
(l nil))
((eq form eof)
(em:warn '|Done!|)
(do ((i (nreverse l) (cdr i)))
((null i)
(sfa-call -em:sfa- 'force-output ())
(em:set-send-lines ()))
(print (car i))))
(setq l (cons (eval form) l)))) (ncons ())))
(defmacro em:read-until-eof (form return . forms)
`((lambda (eof)
(em:message-align)
(do ((,form (em:fread eof) (em:fread eof)))
((eq ,form eof) ,return)
. ,forms)) (ncons ())))
(defmacro em:tyi-until-eof (form return . forms)
`((lambda (-em:filemode-)
(em:message-align)
(do ((,form (tyi -em:sfa- -1) (tyi -em:sfa- -1)))
((= ,form -1) ,return)
. ,forms)) t))
(defun em:tyi-message ()
(let ((ans ()))
(em:tyi-until-eof form (nreverse ans)
(push form ans))))
(defun em:fread n
((lambda (-em:filemode-)
(cond ((zerop n)
(read))
((= n 1)
(read (arg 1)))
((= n 2)
(read (arg 1)(arg 2)))
(t
(break |too many args to FREAD| t))))
t))
(defun em:control-dispatch (char)
(cond ((member char '(#o302 #o342))
(funcall '+internal-↑B-break -em:sfa- char))
((member char '(#o307 #o347))
(↑G))
((member char '(#o303 #o343))
(setq ↑D ()))
((member char '(#o304 #o344))
(setq ↑D t))
(t ((lambda (fun)
(cond (fun (funcall fun -em:sfa- char))
((setq fun (cdr (assoc char
-em:cmchar-table-)))
(funcall fun char) char)
(t char)))
(status ttyint char)))))
(defun em:readonly-vars (l)
;make up message and initial (sixbit . ascii) alist
(em:readonly-init)
(cond ((> (length l) 25.)
(do ((rest l (cdr rest))
(i 25. (1- i))
(first25 ()))
((= i 0)
(append
(em:readonly-vars first25)
(em:readonly-vars rest)))
(push (car l) first25)))
(t
(setq l
(mapcar #'(lambda (x)
(subst () ()
`(,(em:make-sixbit x)
,x () ())))
l))
(em:force-readonly-message)
(do ((nxt (em:get-next-readonly)
(em:get-next-readonly))
(entry))
((equal nxt -1)
(mapcan #'(lambda (x)
(cond
((caddr x)
`((,(cadr x) . ,(cadddr x))))))
l))
(cond ((setq entry (assoc (car nxt) l))
(rplaca (cdddr entry) (cdr nxt))
(rplaca (cddr entry) t)))))))
(declare (special em:line em:lines em:page em:pages))
(defun em:send-next-line ()
(let ((-em:mail-input-buffer-dry-handler- ()))
(cond ((= em:lines em:line)
(cond ((= em:page em:pages)
(break |No right paren found| t))
(t (em:ecommands
'(α p))
(setq em:line 1
em:page (1+ em:page)
em:lines
(cdr (assq 'lines
(em:readonly-vars '(lines)))))
(em:ecommands '(α =)))))
(t (em:ecommands '(⊗ ↔ α =))
(setq em:line (1+ em:line))))))
(defun em:send-this-line ()
(let ((-em:mail-input-buffer-dry-handler- ()))
(cond ((< em:lines em:line)
(cond ((= em:page em:pages)
(break |No right paren found| t))
(t (em:ecommands
'(α p))
(setq em:line 1
em:page (1+ em:page)
em:lines
(cdr (assq 'lines
(em:readonly-vars '(lines)))))
(em:ecommands '(α =)))))
(t (em:ecommands '(α = ⊗ ↔))
(setq em:line (1+ em:line))))))
;;; SEXP on next line
(defun em:eval-next-sexp ()
(em:ecommands '(α β - α β V))
(em:eval-next-sexp1)
(em:ecommands '(α β V)))
(defun em:eval-next-sexp1 ()
(let ((alist (em:readonly-vars '(line lines page pages))))
(setq em:line (cdr (assq 'line alist))
em:lines (cdr (assq 'lines alist))
em:page (cdr (assq 'page alist))
em:pages (cdr (assq 'pages alist))))
(let ((-em:mail-input-buffer-dry-handler- 'em:send-next-line))
(print (eval (read)))))
;;; SEXP on this line
(defun em:eval-this-sexp ()
(em:ecommands '(α β - α β V))
(em:eval-this-sexp1)
(em:ecommands '(α β V)))
(defun em:eval-this-sexp1 ()
(let ((alist (em:readonly-vars '(line lines page pages))))
(setq em:line (cdr (assq 'line alist))
em:lines (cdr (assq 'lines alist))
em:page (cdr (assq 'page alist))
em:pages (cdr (assq 'pages alist))))
(let ((-em:mail-input-buffer-dry-handler- 'em:send-this-line))
(print (eval (read)))))
(defun em:add-cmfun (char fun)
(push `(,char . ,fun) -em:cmchar-table-))
(defun em:delete-cmfun (char)
(setq -em:cmchar-table-
(mapcan
#'(lambda (x)
(cond ((= char (car x)) ())
(t (ncons x))))
-em:cmchar-table-)))
(defun em:ttyint (l)
(let ((entry (assoc (car l) -em:cmchar-table-)))
(cond ((cadr l)
(cond (entry (rplacd entry (cadr l))
(cadr l))
(t (em:add-cmfun (car l)(cadr l)))))
(t (cdr entry)))))
(defun em:transcript-read n
((lambda (form)
(print form)
form)
(apply 'read (listify n))))
(defun em:transcript-off (() ()) (em:transcript ()))
(defun em:transcript (flag)
(cond (flag (setq read 'em:transcript-read)
(em:ecommands '(α X L F I L E ⊗ ↔ α X E V A L ⊗ ↔ ))
(setq -em:mode- 'LFILE)
(em:swallow-alt)
'TRANSCRIPT)
(t (em:ecommands '(α X l t y p e ⊗ ↔))
(setq -em:mode- 'LTYPE)
(setq read ()))))
(defun em:swallow-alt ()
(do ((i (tyi)(tyi)))
((= i #o175) t)))
(defun em:mode (mode) (setq -em:mode- mode))
(defun em:lfile-mode () (setq -em:mode- 'lfile)
(em:ecommands
'(α X L F I L E ⊗ ↔ α X S A Y | | L F I L E | | /m /o /d /e ⊗ ↔))
(setq -em:silence- t))
(defun em:ltype-mode () (setq -em:mode- 'ltype)
(em:ecommands
'(α X L T Y P E ⊗ ↔ α X S A Y | | L T Y P E | | /m /o /d /e ⊗ ↔))
(setq -em:silence- t))
(defun em:lattach-mode () (setq -em:mode- 'lattach)
(em:ecommands
'(α X L A T T A C H ⊗ ↔ α X S A Y | | L A T T A C H | | /m /o /d /e ⊗ ↔))
(setq -em:silence- t))
(defun em:lpend-mode () (setq -em:mode- 'lfile)
(em:ecommands
'(α X L P E N D ⊗ ↔ α X S A Y | | L P E N D | | /m /o /d /e ⊗ ↔))
(setq -em:silence- t))
(defun em:readonly-var (var)
(cdr (assq var (em:readonly-vars `(,var)))))
;;; E Manipulation Routines
;;; These are to help the user edit his MacLisp file.
;;; This routine sends the current sexp no matter where you
;;; are as long as you are `inside' of it
(defun em:send-this-defun ()
(em:ecommands '(α β - α β V))
(em:find-defun-backwards);find the previous defun, defmacro...
(em:eval-this-sexp1) ;evaluate it
(em:ecommands '(α β V)))
(defun em:find-defun-backwards ()
(let ((alist (em:readonly-vars '(line lines page pages))))
(setq em:line (cdr (assq 'line alist))
em:lines (cdr (assq 'lines alist))
em:page (cdr (assq 'page alist))
em:pages (cdr (assq 'pages alist)))
(*catch 'em:find-defun-backwards
(do ((em:page em:page (1- em:page)))
((< em:page 1) (break |Defun not found| t))
(do ((em:line em:line (1- em:line)))
((< em:line 1))
(em:ecommands '(α =))
(cond ((em:defun-on-this-linep (em:tyi-message))
(*throw 'em:find-defun-backwards t)))
(em:ecommands '(⊗ b)))
(em:ecommands '(α - α p α ∞ ⊗ ↔ ⊗ b))
(setq em:lines (cdr (assq 'lines (em:readonly-vars '(lines)))))
(setq em:line em:lines)))))
;;; For now it looks for:
;;; (defun
;;; (defmacro
;;; (macro
;;; (match-macro
;;; (macrodef
(defun em:defun-on-this-linep (text)
(or
(%match '(* #o50 ($ir * em:spacep)
($r ? em:dp)
($r ? em:ep)
($r ? em:fp)
($r ? em:up)
($r ? em:np) ($r ? em:spacep) *) text)
(%match '(* #o50 ($ir * em:spacep)
($r ? em:dp)
($r ? em:ep)
($r ? em:fp)
($r ? em:mp)
($r ? em:ap)
($r ? em:cp)
($r ? em:rp)
($r ? em:op) ($r ? em:spacep) *) text)
(%match '(* #o50 ($ir * em:spacep)
($r ? em:mp)
($r ? em:ap)
($r ? em:tp)
($r ? em:cp)
($r ? em:hp)
($r ? em:-p)
($r ? em:mp)
($r ? em:ap)
($r ? em:cp)
($r ? em:rp)
($r ? em:op) ($r ? em:spacep) *) text)
(%match '(* #o50 ($ir * em:spacep)
($r ? em:mp)
($r ? em:ap)
($r ? em:cp)
($r ? em:rp)
($r ? em:op)
($r ? em:dp)
($r ? em:ep)
($r ? em:fp) ($r ? em:spacep) *) text)
(%match '(* #o50 ($ir * em:spacep)
($r ? em:mp)
($r ? em:ap)
($r ? em:cp)
($r ? em:rp)
($r ? em:op) ($r ? em:spacep) *) text)))
(defun em:spacep (n) (or (= n #o40)
(= n #o11)))
(defun em:dp (n) (or (= n #o104)
(= n #o144)))
(defun em:ep (n) (or (= n #o105)
(= n #o145)))
(defun em:fp (n) (or (= n #o106)
(= n #o146)))
(defun em:up (n) (or (= n #o125)
(= n #o165)))
(defun em:np (n) (or (= n #o116)
(= n #o156)))
(defun em:mp (n) (or (= n #o115)
(= n #o155)))
(defun em:ap (n) (or (= n #o101)
(= n #o141)))
(defun em:cp (n) (or (= n #o103)
(= n #o143)))
(defun em:rp (n) (or (= n #o122)
(= n #o162)))
(defun em:op (n) (or (= n #o117)
(= n #o157)))
(defun em:tp (n) (or (= n #o124)
(= n #o164)))
(defun em:hp (n) (or (= n #o110)
(= n #o150)))
(defun em:-p (n) (= n #o55))
;;; Routines to queue up mail
;;; The queue is an ALIST of array, business address pairs
(defun em:add-queue ()
(let ((ar (*array () 'fixnum 32.)))
(setq -em:queue-
(nconc -em:queue- `(,ar )))
(em:business-address (maknum ar))))
(defun em:get-queue ()
(cond (-em:queue-
(prog2 ()
(em:business-address
(maknum (car -em:queue-)))
(setq -em:queue- (cdr -em:queue-))))))
;;; αxSLISP dsk:maclsp.dmp[1,3](elisp.ini)
;;; αnαxSLISP talks to job n(10.)
;;; α0αxSLISP types the wholine of inferior
;;; α-αxSLISP murder (i.e. negotiated suicide)
;;; α= send arrow line or attach buffer
;;; α+nα= send next n lines
;;; α-nα= send previous n lines
;;; αx= <sexp>
;;; send comand line
;;;
;;; Protocols: (* means not actually anticipated to be used; current
;;; implementation knows about it but does not send and/or interpret them
;;; specially)
;;;
;;; From E to MacLisp
;;; Mail
;;; wd0: Job# sending message
;;; wd1: type of message
;;;
;;; 2,,0: Continuation needed
;;; 1,,0: Short (fits in the next =30 words, ends with null byte
;;; or falls off)
;;;
;;; 0 no-op
;;; 1 initiating a conversation
;;; 2 ok (did the jobread)
;;; 3 SEXPs
;;; 4 explicit eof
;;; 5 control (meta) chars to follow (E macro format)
;;; (or E commands (from MacLisp to E))
;;; 6 interrupt. do <esc>i <char>
;;; 7 close connection (suicide)
;;; 8 readonly variables
;;;
;;; wd2: -number of bytes,,address of buffer
;;;
;;;
;;; E commands will be represented in the standard E macro manner
;;; (unless there is something better).
;;;
;;;
;;; Protocol is:
;;; E MacLisp
;;; ---------------
;;; initiate
;;; ok
;;;
;;; To send a short message just a MAIL
;;; To send a long message MAIL then wait for JOBREAD acknowledge
;;; To send interrupts, just send them
;;; Acknowledgment is the short OK message
;;;
;;; Commands needed:
;;; start DMP file
;;; send control chars
;;; send interrupt character (just 1 at a time)
;;;
;;; Mail Interface
(lap em:MAIL-interface subr)
(defsym rovmailblksize 50.)
(defsym mlblksize 32.)
(defsym freeac #o13)
(defsym cntrl-bit #o200)
(defsym meta-bit #o400)
(defsym ccntrlg #o307)
(defsym cntrlg #o347)
(defsym ccntrlx #o330)
(defsym cntrlx #o370)
(defsym EPR #o456062)
(defsym noutbytes #o12000)
(defsym nrovbytes #o1000)
(defsym rdblk #o2000)
(defsym blksize #o2000)
(defsym maxshort 145.)
(defsym rovmaxshort 29.)
(defsym noop-type 0)
(defsym initiate-type 1)
(defsym ok-type 2)
(defsym sexp-type 3)
(defsym explicit-eof-type 4)
(defsym ecommand-type 5)
(defsym interrupt-type 6)
(defsym kill-type 7)
(defsym readonlyvar-type 8.)
(defsym high-command 8.)
(defsym bs #o177)
(defsym lf #o12)
(defsym cr #o15)
(defsym space #o40)
(defsym tab #o11)
(defsym alpha 2)
(defsym beta 3)
(defsym cont-bit 2)
(defsym short-bit 1)
(defsym meta-mask 400)
(defsym control-mask 200)
;;; Silly jobnum was never set
setjob (movem tt ijobnum)
(movem tt ojobnum)
(movem tt jobread)
(jsp t fxcons) ;number cons
(movem a (special si:ejobnum)) ;save it
(popj p)
true (movei a 't)
(popj p)
false (movei a 'nil)
(popj p)
(entry em:get-jobnum subr)
(args em:get-jobnum (nil . 0))
(move tt (special si:ejobnum))
(movem tt ijobnum)
(movem tt ojobnum)
(movem tt jobread)
(jsp t fxcons)
(movem a (special si:ejobnum))
(jrst 0 em:get-terminal)
(entry em:set-jobnum subr)
(args em:set-jobnum (nil . 1))
(move tt 0 a)
(movem tt ijobnum)
(movem a (special si:ejobnum))
(movem tt ojobnum)
(popj p)
clrwrongj
(sosg 0 critical)
(721←33 0 mailint) ;imskst
wrongj (movei a 'wrong-jobnum)
(popj p)
;;; Mail Type
em:process-mail
(setzm 0 tyi-inited)
(entry em:mail-type subr)
(args em:mail-type (nil . 0))
em:mail-type
(setzm 0 explicit-eof) ;0 means nil
(setzm 0 forcedp)
(move tt (+ imailbox 1));type bits
(movei a 'nil)
(tlne tt cont-bit)
(movei a 't)
(movem a (special -em:contp-))
(hrrzs 0 tt) ;grumble, test for range
(skipge 0 tt) ;too low?
(jrst 0 unknown) ;yup, unknown
(caile tt high-command) ;too high
(jrst 0 unknown)
(jrst 0 @ type-disp tt) ;dispatch
unknown (movei a 'unknown)
(popj p)
type-disp
(0 0 no-op)
(0 0 initiate)
(0 0 ok)
(0 0 sexps)
(0 0 explicit-eof)
(0 0 e-command)
(0 0 interrupt)
(0 0 kill)
(0 0 readonlyvars)
e-command
(movei a 'ecommand)
(popj p)
no-op
(movei a 'no-op)
(popj p)
sexps
(move a (+ imailbox 2)) ;get number of bytes
(move tt (+ imailbox 1)) ;type bits
(setzm 0 tyi-inited) ;tyi not inited
(hlrem a inbytes) ;store it
(hlre b a) ;-number of bytes
(idivi b 4) ;-number of words
(jumpe c ztesch)
(subi b 1) ;one more, bunkie
ztesch
(movem b inwords)
(move b inpointtem)
(movem b inpoint)
(skipe 0 withinrov)
(setom 0 delayedsexp)
(setzm 0 mailinp)
(tlne tt short-bit) ;short?
(jrst 0 tshort)
(pushj p transfer-buffer)
(movei a 'sexps)
(popj p)
tshort (pushj p transfer-short)
(movei a 'sexps)
(popj p)
initiate(movei a 'initiate)
(setzm 0 mailinp)
(popj p)
readonlyvars
(movei tt rovmail)
(movem tt transfer-spot)
(movei tt rovmailblksize)
(movem tt transfer-size)
(move a (+ imailbox 2)) ;number of bytes
(hlrem a rinbytes)
(movem a inwords)
(move a irovpointtem)
(movem a irovpoint)
(setzm 0 mailinp)
(move tt (+ imailbox 1)) ;type bits
(tlne tt short-bit) ;short?
(jrst 0 rtshort)
(pushj p transfer-buffer)
(movei a 'readonlyvars)
(popj p)
rtshort (pushj p transfer-short)
(movei a 'readonlyvars)
(popj p)
interrupt
(movei a 'interrupt)
(setzm 0 mailinp)
(popj p)
explicit-eof
(setom 0 explicit-eof)
(movei a 'eof)
(popj p)
ok
(movei a 'ok)
(setzm 0 mailinp)
(popj p)
kill
(calli 1 12) ;kill self
;;; Wait Mail
(entry em:wait-mail subr)
(args em:wait-mail (nil . 0))
em:wait-mail
(skipe 0 tyop)
(pushj p force2)
wm6 (skipn 0 (special -em:queue-))
(jrst 0 wm7)
(movei t wm2)
(jrst 0 wm4)
wm7 (skipe 0 (special -em:mail-input-buffer-dry-handler-))
(pushj p em:call-handler)
wm1
(mail 1 imailbox) ;WRCV
(setom 0 newwrcv)
wm2 (hlrz tt imailbox) ;get EPR half
(caie tt epr) ;is it EPR (in sixbit)?
(jrst 0 wm6)
(hrrz tt imailbox) ;get the jobnum
(skipg 0 ijobnum)
(pushj p setjob)
(came tt ijobnum) ;correct one?
(jrst 0 wm6)
wm3
(setom 0 mailinp) ;mail now in
(setzm 0 tyi-inited)
(movei a 't)
(popj p)
wm4 (movem freeac (+ svdacs 9.))
(movei freeac svdacs)
(hrli freeac b)
(blt freeac (+ svdacs 9.))
(setz b)
(movei freeac c)
(hrli freeac b)
(blt freeac freeac)
(call 0 'em:get-queue)
(hrlz tt 0 a) ;address of mailbox
(hrri tt imailbox)
(blt tt (+ imailbox (- mlblksize 1))) ;transfer it
(hrlzi freeac svdacs)
(hrri freeac b)
(blt freeac freeac)
(jrst 0 0 t)
;;; Mask Routines
(entry em:mask-off subr)
(args em:mask-off (nil . 0))
(aos 0 critical)
(722←33 0 mailint) ;imskcl
(movei a 't)
(popj p)
(entry em:turn-mask-off subr)
(args em:turn-mask-off (nil . 0))
(722←33 0 mailint) ;imskcl
(movei a 't)
(popj p)
(entry em:mask-on subr)
(args em:mask-on (nil . 0))
(sosg 0 critical)
(721←33 0 mailint) ;imskst
(movei a 't)
(popj p)
em:call-handler
(movem freeac (+ svdacs 9.))
(movei freeac svdacs)
(hrli freeac b)
(blt freeac (+ svdacs 9.))
(setz b)
(movei freeac c)
(hrli freeac b)
(blt freeac freeac)
(move a (special -em:mail-input-buffer-dry-handler-))
(callf 0 0 1)
(hrlzi freeac svdacs)
(hrri freeac b)
(blt freeac freeac)
(skipn 0 delayedsexp)
(popj p)
(sub p (% 0 0 1 1))
(jrst 0 wm2)
;;; Mail SFA
(entry em:mail-sfa subr)
(args em:mail-sfa (nil . 3))
(movei a 0 b) ;operation type ignore the object
(caie a 'which-operations)
(jrst 0 t1)
(movei a '(tyi tyo terpri force-output untyi charpos linel
force-readonly-message send-lines report-send-lines
ttyint))
(popj p)
t1 (cain a 'tyi) ;tyi?
(jrst 0 em:mail-tyi)
(cain a 'tyo) ;tyo?
(jrst 0 em:mail-tyo)
(cain a 'terpri)
(jrst 0 em:terpri)
(cain a 'force-output) ;force output?
(jrst 0 em:mail-force-output)
(cain a 'untyi) ;untyi?
(jrst 0 em:mail-untyi)
(cain a 'charpos)
(jrst 0 em:mail-charpos)
(cain a 'linel)
(jrst 0 em:mail-linel)
(cain a 'send-lines)
(jrst 0 isend-lines)
(cain a 'report-send-lines)
(jrst 0 report-send-lines)
(cain a 'force-readonly-message)
(jrst 0 em:force-readonly-message)
(cain a 'ttyint)
(jrst 0 em:ttyint1)
(movei a 'nil)
(popj p)
(entry em:mail-charpos subr)
(args em:mail-charpos (nil . 0))
em:mail-charpos
(skipn 0 c)
(jrst 0 g2)
(hrrz a c)
(move c 0 a)
(movem c charpos)
(popj p)
g2 (move tt charpos)
(jrst 0 fix1)
em:mail-linel
(skipn 0 c)
(jrst 0 g3)
(hrrz a c)
(movem a (special -em:linel-))
(popj p)
g3 (move a (special -em:linel-))
(popj p)
; (movei t g1)
; (push p t)
; (push p (% 0 0 't))
; (movni t 1)
; (jcall 16 'linel)
;g1 (popj p)
isend-lines
(movem c send-lines)
(move c @ c)
(movem c skipp)
(movem c vsend-lines)
(movei a 't)
(popj p)
report-send-lines
(move a send-lines)
(popj p)
(entry em:init-send-lines subr)
(args em:init-send-lines (nil . 0))
(movei a (+ noutbytes 1))
(movem a outbytes)
(movei a (+ nrovbytes 1))
(movem a rovbytes)
(movei tt 0)
(movem tt vsend-lines)
(movem tt skipp)
(movei a 'NIL)
(movem a send-lines)
(popj p)
em:terpri
(setzm 0 )
(setzm 0 forcedp)
(setom 0 tyop)
(movei a cr)
(pushj p tyo1)
(movei a lf)
(jrst 0 tyo1)
em:ttyint1
(move a c)
(jcall 1 'em:ttyint)
;;; Tyi
(entry em:mail-tyi subr)
em:mail-tyi
(skipe 0 explicit-eof)
(jrst 0 eeof)
(movem c eofchar)
(skipe 0 untyif)
(jrst 0 untyi2)
(skipn 0 tyi-inited) ;not inited?
(pushj p real-mail-refresh)
ityi (skipe 0 inbytes) ;and nothing left?
(jrst 0 tyi1)
(skipe 0 (special -em:contp-)) ;a continuation?
(jrst 0 tyi2)
(skipe 0 (special -em:filemode-)) ;in special file mode?
(jrst 0 reof)
tyi2 (pushj p mail-refresh)
tyi1 (aosle 0 inbytes)
(pushj p mail-refresh)
inmailok
(setzm 0 newwrcv)
(ildb tt inpoint) ;get byte
(trne tt cntrl-bit)
(jrst 0 pondercntrl)
(jrst 0 fix1) ;what a bum!
(pushj p mail-refresh)
(jrst 0 tyi1)
em:mail-untyi
(aos 0 untyif)
(move b untyipdl)
(push b c)
(movem b untyipdl)
(popj p)
untyi2 (move b untyipdl)
(sosl 0 untyif)
(pop b a)
(movem b untyipdl)
(popj p)
eeof (setzm 0 explicit-eof)
reof
(move a eofchar)
(sub p (% 0 0 1 1))
(popj p)
pondercntrl
(trnn tt meta-bit) ;foo it was control-meta
(jrst 0 tyi3)
(jrst 0 fix1) ;what a bum!
tyi3 (caie tt ccntrlg) ;↑G
(cain tt cntrlg) ;↑g
(call 0 '↑G)
(caie tt ccntrlx) ;↑X
(cain tt cntrlx) ;↑x
(jrst 0 ↑Xhandler)
(movei tt 0 tt)
(jsp t fxcons)
(call 1 'em:control-dispatch)
(popj p)
↑Xhandler
(movei t em:mail-tyi)
(push p t)
(push p (% 0 0 'quit))
(movni t 1)
(jcall 16 'error)
;;; Tyo
(entry em:mail-tyo subr)
em:mail-tyo
(setzm 0 forcedp)
(setom 0 tyop)
(move a @ c)
(caie a cr)
(cain a lf)
(skipa)
(setom 0 noncrlf) ;means a non crlf char has been sent
tyo1 (pushj p ucharpos) ;update charpos
(idpb a outpoint) ;put it there
(sosg 0 outbytes) ;ready to send?
(pushj p cmail-sendit)
(caie a lf)
(jrst 0 true)
forceit
(skipn 0 noncrlf)
(jrst 0 true) ;only crlf's so far
(skipn 0 send-lines) ;if T then just return
(jrst 0 fmail-sendit)
(movei tt 't)
(camn tt send-lines)
(jrst 0 true)
(sosle 0 skipp) ;ready to do it?
(jrst 0 true)
(jrst 0 fmail-sendit)
;;; special entry for Refresh case only
force2 (skipe 0 send-lines) ;if T then just return
(popj p)
(jrst 0 fmail-sendit)
ucharpos
(caie a cr) ;cr
(jrst 0 uchrp1)
(setzm 0 charpos)
(popj p)
uchrp1 (cain a bs)
(jrst 0 adjstbs)
(cain a tab) ;tab
(jrst 0 adjstab)
(aos 0 charpos)
(popj p)
adjstab (move tt charpos)
(idivi tt 8.)
(aos 0 tt)
(imuli tt 8.)
(movem tt charpos)
(popj p)
adjstbs (aos 0 charpos)
(popj p)
;;; Force Output
fmail-sendit
(setom 0 forcedp)
(setz b)
(jrst 0 mail-sendit)
cmail-sendit
(movei tt cont-bit)
(jrst 0 mail-sendit)
em:mail-force-output
(entry em:mail-force-output subr)
(skipe 0 forcedp)
(jrst 0 true)
(setz b) ;continuation
mail-sendit
(setzm 0 noncrlf)
(setzm 0 charpos)
(setzm 0 tyop)
(move a vsend-lines)
(movem a skipp)
(skipe 0 (special -em:silence-))
(jrst 0 skipit)
(hrlzi a omailbox)
(hrri a (+ omailbox 1))
(setzm 0 omailbox)
(blt a (+ omailbox (- mlblksize 1))) ;zero it
(movei a outmail) ;address of buffer
(movem a (+ omailbox 2))
(move a outbytes)
(movei a (+ noutbytes 1))
(sub a outbytes)
(movei t 1) ;1 in t means long
(caile a maxshort) ;short enough
(jrst 0 send-message) ;nope
(setz t) ;0 in T means short
(hrlzi tt outmail)
(hrri tt (+ omailbox 3))
(blt tt (+ omailbox (- mlblksize 1))) ;move to the right place
(iori b short-bit)
send-message
(hrl tt b) ;swap
(hrri tt sexp-type)
(skipe 0 (special -em:ecommands-))
(hrri tt ecommand-type)
(movem tt (+ omailbox 1))
(movns 0 a)
(hrlzm a (+ omailbox 2))
(movei a outmail)
(hrrm a (+ omailbox 2))
(move a thisjob)
(hrli a epr) ;epr validation
(movem a omailbox)
(aos 0 critical)
(722←33 0 mailint) ;imskcl
(mail 5 ojobnum) ;mail it
(jsp tt wait-for-clear)
(skipa)
(jrst 0 clrwrongj) ;clear critical region and report wrong job
(sosg 0 critical)
(721←33 0 mailint) ;imskst
skipit (setzm 0 (special -em:silence-))
(move a outpointtem) ;setup output byte count
(movem a outpoint)
(movei a (+ noutbytes 1))
(movem a outbytes)
(jumpe t sm2) ;don't hang around
(pushj p wait-ok) ;wait for acknowledgment
(pushj p em:mail-type)
(came a 'ok)
(jrst 0 false)
sm2 (hrlzi a outmail)
(hrri a (+ outmail 1))
(setzm 0 outmail)
(blt a (+ outmail (- rdblk 1))) ;zero it
(jrst 0 true)
;;; Message Align
;;; Routine to get to a buffer from E with not all <cr>s in it
(entry em:message-align subr)
(args em:message-align (nil . 0))
em:message-align
(skipe 0 newwrcv)
(jrst 0 true)
(move tt inpoint) ;copy of byte pointer
(move t inbytes)
filalgn2
(aosle 0 t)
(jrst 0 filalgn1)
(setzm 0 newwrcv)
(ildb a tt)
(skipn 0 a)
(jrst 0 alnxtx)
(caie a tab)
(cain a space)
(jrst 0 alnxtx)
(caie a cr) ;a cr?
(cain a lf) ;a lf?
(skipa)
(jrst 0 true)
alnxtx (ibp 0 inpoint)
(aos 0 inbytes)
(jrst 0 filalgn2)
filalgn1
(pushj p mail-refresh)
(move tt inpoint)
(move t inbytes)
(popj p)
;;; Mail Refresh
;;; This routine gets fresh mail to initialize the reader
mail-refresh
real-mail-refresh
(aos 0 critical)
(722←33 0 mailint) ;imskcl
mr2
mr3 (pushj p em:wait-mail) ;wait for response
(pushj p em:process-mail) ;get the mail
(caie a 'sexps)
(jrst 0 mr3)
(sosg 0 critical)
(721←33 0 mailint) ;imskst
(popj p)
;;; Transfer Buffer
;;; This routine does a jobread into the right spot.
transfer-buffer
(setom 0 tyi-inited) ;ready to read
(move a transfer-spot)
(hrrzm a (+ jobread 2))
(pushj p zinmail)
(move a (+ imailbox 2))
(hrl a inwords)
(movem a (+ jobread 1))
(movei tt jobread)
(calli tt 400050) ;jobrd
(jrst 0 false)
(jrst 0 send-ok)
transfer-short
(pushj p zinmail)
(hrlzi a (+ imailbox 3)) ;move from here
(hrr a transfer-spot) ;to here
(move tt transfer-spot)
(addi tt (- mlblksize 1))
(blt a 0 tt) ;transfer 29
(setom 0 tyi-inited) ;ready to read
(popj p)
zinmail
(hrlz a transfer-spot)
(move tt transfer-spot)
(aos 0 tt)
(hrr a tt)
(setzm 0 @ transfer-spot)
(move tt transfer-spot)
(add tt transfer-size)
(blt a -1 tt)
(popj p)
(entry em:clear-input subr)
(args em:clear-input (nil . 0))
(setzm 0 critical)
(setzm 0 tyop)
(setzm 0 forcedp)
(setzm 0 noncrlf)
(setzm 0 untyif)
(setzm 0 inbytes)
(setzm 0 rinbytes)
(move a temuntyipdl)
(movem a untyipdl)
(setom 0 explicit-eof)
(setzm 0 mailinp)
(setzm 0 tyi-inited)
(pushj p zinmail)
(movei a 't)
(popj p)
;;; Wait OK
wait-ok
(aos 0 critical)
(722←33 0 mailint) ; mskcl
(skipn 0 (special -em:queue-))
(jrst 0 wo2)
(movei t wo1)
(jrst 0 wm4)
wo2 (mail 1 imailbox) ;WRCV
wo1 (sosg 0 critical)
(721←33 0 mailint) ;imskst
(move tt (+ imailbox 2))
(hrrzs tt) ;flush short?
(caie tt ok-type)
(jrst 0 true)
(jrst 0 false)
;;; Send Simple Message
(entry em:send-simple-message subr)
(args em:send-simple-message (nil . 1))
(cain a 'ok)
(jrst 0 ok-message)
(cain a 'initiate)
(jrst 0 initiate-message)
(cain a 'hold-it)
(jrst 0 hold-it-message)
(cain a 'eof)
(jrst 0 eof-message)
(movei a 'Invalid-message)
(popj p)
eof-message
(movei a explicit-eof-type)
(jrst 0 send-simple-message)
initiate-message
(movei a initiate-type)
(jrst 0 send-simple-message)
ok-message
(movei a ok-type)
(jrst 0 send-simple-message)
hold-it-message
(movei a 102)
(movem a (+ omailbox 2))
(movei a interrupt-type)
send-simple-message
(movem a (+ omailbox 1))
(move b thisjob)
(hrli b epr)
(movem b omailbox)
(mail 5 ojobnum)
(jsp tt wait-for-clear)
(jrst 0 true)
(jrst 0 false)
(entry wfc subr)
wait-for-clear
(mail 3)
(jrst 0 wfc1) ;nothing there?
(movem freeac (+ svdacs 9.))
(movei freeac svdacs)
(hrli freeac b)
(blt freeac (+ svdacs 9.))
(setz b)
(movei freeac c)
(hrli freeac b)
(blt freeac freeac)
(call 0 'em:add-queue)
(hrrz tt 0 a) ;address of mailbox
(mail 2 0 tt) ;get mail
(jfcl) ;huh?
(hrlzi freeac svdacs)
(hrri freeac b)
(blt freeac freeac)
wfc1 (setz a)
(calli a 31)
(jrst 0 -2 tt)
;;;; Send Control Char
;
;(entry em:send-control-char subr)
;(args em:send-control-char (nil . 1))
;
;send-control-char
; (movei t -1) ;count
; (move tt outchartem)
; (move a 0 a) ;get character
; (trne a 600) ;control and meta?
; (jrst 0 cm1)
; (trze a 200) ;control bit
; (pushj p c1) ;push control
; (trze a 400) ;meta bit
; (pushj p m1) ;push meta
;cm2 (aos 0 charpos)
; (idpb a tt)
; (movei a ecommand-type)
; (hrli a short-bit) ;short control chars
; (movem a (+ omailbox 1))
; (hrlzm t (+ omailbox 2))
; (movei a outmail)
; (hrrm a (+ omailbox 2))
;
; (move b thisjob)
; (hrli b epr)
; (movem b omailbox)
; (mail 5 ojobnum)
; (jsp tt wait-for-clear)
; (jrst 0 true)
; (jrst 0 false)
;
;c1 (movei r 2) ;alpha
; (aos 0 charpos)
; (idpb r tt) ;send it
; (sos 0 t) ;decrement
; (popj p)
;
;m1 (movei r 3) ;beta
; (aos 0 charpos)
; (idpb r tt) ;send it
; (sos 0 t) ;decrement
; (popj p)
;
;cm1 (movei r #o26)
; (aos 0 charpos)
; (idpb r tt)
; (sos 0 t)
; (trz r 600)
; (jrst 0 cm2)
;;; Em:init
(entry em:init subr)
(args em:init (nil . 0))
(setzm 0 newwrcv)
(setzm 0 withinrov)
(setzm 0 delayedsexp)
(movei tt inmail)
(movem tt transfer-spot)
(movei tt blksize)
(movem tt transfer-size)
(movei tt (+ noutbytes 1))
(movem tt outbytes)
(movei tt (+ nrovbytes 1))
(movem tt rovbytes)
(calli tt #o30)
(movem tt thisjob)
(jrst 0 fix1)
em:get-terminal
(movei tt #o236)
(calli tt #o33) ;jobtlin
(add tt ijobnum) ;add jobnum
(calli tt #o33) ;get terminal line number
(hrrzm tt termlin) ;save it
(popj p)
(entry em:warn subr)
(args em:warn (nil . 1))
(call 1 'exploden)
(movei tt 500.)
(move t mpointtem)
(move a 0 a)
wloop (hlrz b a)
(move b 0 b)
(idpb b t)
(sosge 0 tt)
(jrst 0 wdone)
(skipn 0 b)
(jrst 0 wdone)
(move a 0 a)
(jrst 0 wloop)
wdone
(move tt termlin)
(calli tt #o400111) ;beep it
(movei a dmess)
(movem a (+ termlin 1))
(movei tt termlin)
(calli tt #o400047)
(jrst 0 false)
(jrst 0 true)
(popj p)
;;; Send OK
send-ok
(movei a ok-type)
(movem a (+ omailbox 1))
(move b thisjob)
(hrli b epr)
(movem b omailbox)
(mail 5 ojobnum)
(jsp tt wait-for-clear)
(jrst 0 true)
(jrst 0 false)
;;; Em:eval-protect
(entry em:eval-protect subr)
(args em:eval-protect (nil . 0))
(movei a 'em:sail-mail-interrupt-handler)
(movem a (special si:sail-mail-service))
(movei a 't)
(popj p)
(entry em:eval-unprotect subr)
(args em:eval-unprotect (nil . 0))
(movei a 'nil)
(movem a (special si:sail-mail-service))
(popj p)
;;; Mail queue
(entry em:business-address subr)
(args em:business-address (nil . 1))
(hrrz a 0 a) ;get address
(hrrz tt 0 a)
(hrrzi tt 4 tt) ;business address
(jrst 0 fix1) ;return it
(entry em:mail-interrupt-handler subr)
(args em:mail-interrupt-handler (nil . 1))
(mail 3)
(jrst 0 false)
(call 0 'em:add-queue)
(hrrz tt 0 a) ;get address for buffer
(mail 2 0 tt) ;get the mail
(jfcl) ;huh?
(hlrz d 0 tt) ;validation
(caie d epr)
(jrst 0 false)
(hrrz d 0 tt)
(came d ijobnum)
(jrst 0 false)
(hrrz d 1 tt) ;type
(cain d kill-type)
(calli 1 12) ;suicide
(caie d interrupt-type) ;control char?
(jrst 0 true) ;no, just report the incident
(move tt 2 tt)
(tro tt #o200) ;controlify it
(jsp t fxcons)
(jcall 1 'em:control-dispatch)
;;; Readonly Variables
;;; Routines for obtaining the values of readonly variables
(entry em:readonly-init subr)
(args em:readonly-init (nil . 0))
(aos 0 critical)
(722←33 0 mailint) ;imskcl
;inited mailinp
;0 0 ?
;0 -1 in but not inited, must refresh
;-1 0 ok
;-1 -1 contradiction
(setom 0 withinrov)
(move tt tyop)
(movem tt otyop)
(move tt tyi-inited)
(movem tt otyi-inited)
(move tt transfer-spot)
(movem tt otransfer-spot)
(move tt transfer-size)
(movem tt otransfer-size)
(setzm 0 tyop)
(jrst 0 true)
(entry em:make-sixbit subr)
(args em:make-sixbit (nil . 1))
;;; Takes list of variables and returns an alist of variable-value pairs
sixmak (movei b '6) ;direct lift from faslap
(call 2 'pnget)
(hlrz a 0 a)
(move tt 0 a)
(idpb tt rovpoint) ;put it there
(sosle 0 rovbytes) ;ready to send?
(jrst 0 fix1) ;return fixnum
;;; Read only variable mail message
(entry em:force-readonly-message subr)
(args em:force-readonly-message (nil . 0))
em:force-readonly-message
(setzm 0 tyi-inited)
(movei a rovmail) ;address of buffer
(movem a (+ omailbox 2))
(move a rovbytes)
(movei a (+ nrovbytes 1))
(sub a rovbytes)
(movei t 1) ;1 in t means long
(caile a rovmaxshort) ;short enough
(jrst 0 rovsend-message) ;nope
(setz t) ;0 in T means short
(hrlzi tt rovmail)
(hrri tt (+ omailbox 3))
(blt tt (+ omailbox (- mlblksize 1))) ;move to the right place
(iori b short-bit)
rovsend-message
(hrl tt b) ;swap
(hrri tt readonlyvar-type)
(movem tt (+ omailbox 1))
(movns 0 a)
(hrlzm a (+ omailbox 2))
(movei a rovmail)
(hrrm a (+ omailbox 2))
(move a thisjob)
(hrli a epr) ;epr validation
(movem a omailbox)
(mail 5 ojobnum) ;mail it
(jsp tt wait-for-clear)
(skipa)
(jrst 0 wrongj)
(hrlzi a rovmail) ;zeros output buffer
(hrri a (+ rovmail 1))
(setzm 0 rovmail)
(blt a (+ rovmail (- rovmailblksize 1))) ;zero it
(move a rovpointtem) ;setup output byte count
(movem a rovpoint)
(movei a (+ nrovbytes 1))
(setzm 0 rinbytes)
(movem a rovbytes)
(jumpe t true) ;don't hang around
(pushj p wait-ok) ;wait for acknowledgment
(pushj p em:mail-type)
(came a 'ok)
(jrst 0 false)
(jrst 0 true)
(entry em:get-next-readonly subr)
(args em:get-next-readonly (nil . 0))
(skipn 0 tyi-inited)
(pushj p rovmail-refresh)
(aosle 0 rinbytes)
(jrst 0 rovdone)
(setzm 0 newwrcv)
(ildb tt irovpoint) ;get it
(jsp t fxcons)
(push fxp a) ;save it
(aosle 0 rinbytes)
(jrst 0 (- rovdone 1))
(ildb tt irovpoint)
(jsp t fxcons)
(pop fxp b)
(jcall 2 'xcons)
(sub fxp (% 0 0 1 1))
rovdone
(move tt otyi-inited)
(movem tt tyi-inited)
(move tt otransfer-spot)
(movem tt transfer-spot)
(move tt otransfer-size)
(movem tt transfer-size)
(move tt otyop)
(movem tt tyop)
(setzm 0 withinrov)
(sosg 0 critical)
(721←33 0 mailint) ;imskst
(seto tt)
(jrst 0 fix1)
rovmail-refresh
rm2 (pushj p em:wait-mail)
(pushj p em:process-mail)
(cain a 'readonlyvars)
(popj p)
(jrst 0 rm2)
;;;; Debugging Routines
;
;(entry em:inbytes subr)
; (move tt inbytes)
; (jrst 0 fix1)
;
;(entry em:rinbytes subr)
; (move tt rinbytes)
; (jrst 0 fix1)
;
;(entry em:get-rov-mail subr)
; (pushj p rovmail-refresh)
; (movei a 't)
; (popj p)
;
;(entry suicide subr)
; (0)
; (jrst 0 true)
;;; Storage for Mail routines
critical (0)
delayedsexp (0) ;states whether an sexpr came in during
;an input buffer dry demon execution
newwrcv (0) ;is not 0 when a WRCV has been done without any
;ilbp being done
withinrov (0)
transfer-spot (0)
otransfer-spot (0)
transfer-size (0)
otransfer-size (0)
svdacs (block 10.)
send-lines (0)
noncrlf (0)
vsend-lines (0)
skipp (0)
tyop (0)
otyop (0)
forcedp (0) ;output already forced
inwords (0) ;number of words to input via jobread
explicit-eof (-1) ;nil
mailint (4000000000)
ijobnum (-1)
(0 0 imailbox)
ojobnum (-1)
(0 0 omailbox)
imailbox (block mlblksize) ;mail
omailbox (block mlblksize) ;mail
inmail (block blksize) ;text
outmail (block blksize) ;text
rovmail (block rovmailblksize)
stack (block 20)
untyipdl (777760←22 0 stack)
temuntyipdl (777760←22 0 stack)
untyif (0)
termlin (0)
(0 0 dmess)
dmess (block 100.)
(0)
mpointtem (700←22 0 (- dmess 1))
inpoint (1100←22 0 (- inmail 1))
inpointtem (1100←22 0 (- inmail 1))
irovpoint (4400←22 0 (- rovmail 1))
irovpointtem (4400←22 0 (- rovmail 1))
rinbytes (0)
inbytes (0)
outpoint (700←22 0 (- outmail 1))
outpointtem (700←22 0 (- outmail 1))
rovpoint (4400←22 0 (- rovmail 1))
rovpointtem (4400←22 0 (- rovmail 1))
outchartem (700←22 0 (+ omailbox 2))
outbytes (0 0 (+ noutbytes 1))
rovbytes (0 0 (+ nrovbytes 1))
mailinp (0) ;-1 means in
charpos (0)
thisjob (0)
tyi-inited (0) ;ready to read. 0 = nil, -1 = t
otyi-inited (0) ;ready to read. 0 = nil, -1 = t
eofchar (0) ;eof char
jobread (0)
(0)
(0 0 inmail)
()
(or (and (boundp 'em:no-init) em:no-init)
(progn
(em:mail-interface-initialize)))